perm filename BASIC.LAP[206,JMC] blob
sn#072125 filedate 1973-11-14 generic text, type T, neo UTF8
(DEFPROP BASICFNS (BASICFNS ORLIS ANDLIS MAPCAR2 MAPCHOOSE MAPAPP PRUP LISTSUBT LISTSUBTA CONTAINED DELETE PICKO→
UT PICKOUTA) VALUE)
(LAP ORLIS SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPE 2 TAG2)
(HLRZ@ 1 2)
(CALLF@ 1 -1 P)
(JUMPN 1 TAG1)
(HRRZ@ 2 0 P)
(MOVE 1 -1 P)
(CALL 2 (E ORLIS) S)
(JUMPN 1 TAG1)
TAG2 (TDZA 1 1)
TAG1 (MOVEI 1 (QUOTE T) S)
(SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP ANDLIS SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPE 2 TAG1)
(HLRZ@ 1 2)
(CALLF@ 1 -1 P)
(JUMPE 1 TAG5)
(HRRZ@ 2 0 P)
(MOVE 1 -1 P)
(CALL 2 (E ANDLIS) S)
(JUMPN 1 TAG1)
TAG5 (TDZA 1 1)
TAG1 (MOVEI 1 (QUOTE T) S)
(SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP MAPCAR2 SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(MOVE 1 2)
(JUMPE 1 TAG1)
(HLRZ@ 2 0 P)
(HLRZ@ 1 -1 P)
(CALLF@ 2 -2 P)
(HRRZ@ 3 0 P)
(HRRZ@ 2 -1 P)
(PUSH P 1)
(MOVE 1 -3 P)
(CALL 3 (E MAPCAR2) S)
(POP P 2)
(CALL 2 (E XCONS) S)
TAG1 (SUB P (C 3 0 3 0))
(POPJ P)
NIL
(LAP MAPCHOOSE SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(MOVE 1 3)
(JUMPE 1 TAG1)
(HLRZ@ 1 1)
(CALLF@ 1 -2 P)
(JUMPE 1 TAG2)
(HLRZ@ 1 0 P)
(CALLF@ 1 -1 P)
(HRRZ@ 3 0 P)
(MOVE 2 -1 P)
(PUSH P 1)
(MOVE 1 -3 P)
(CALL 3 (E MAPCHOOSE) S)
(POP P 2)
(CALL 2 (E XCONS) S)
(JRST 0 TAG1)
TAG2 (HRRZ@ 3 0 P)
(MOVE 2 -1 P)
(MOVE 1 -2 P)
(CALL 3 (E MAPCHOOSE) S)
TAG1 (SUB P (C 3 0 3 0))
(POPJ P)
NIL
(LAP MAPAPP SUBR)
(PUSH P 1)
(PUSH P 2)
(MOVE 1 2)
(JUMPE 1 TAG1)
(HLRZ@ 1 0 P)
(CALLF@ 1 -1 P)
(HRRZ@ 2 0 P)
(PUSH P 1)
(MOVE 1 -2 P)
(CALL 2 (E MAPAPP) S)
(MOVE 2 1)
(POP P 1)
(CALL 2 (E *APPEND) S)
TAG1 (SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP PRUP SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPN 1 TAG2)
(MOVE 1 2)
(JUMPE 1 TAG4)
(MOVEI 1 (QUOTE (V LONGER - PRUP)) S)
(CALL 1 (E ERROR) S)
TAG4 (JRST 0 TAG1)
TAG2 (JUMPN 2 TAG7)
(MOVEI 1 (QUOTE (U LONGER - PRUP)) S)
(CALL 1 (E ERROR) S)
(JRST 0 TAG1)
TAG7 (HLRZ@ 2 0 P)
(HLRZ@ 1 -1 P)
(CALL 2 (E CONS) S)
(HRRZ@ 2 0 P)
(PUSH P 1)
(HRRZ@ 1 -2 P)
(CALL 2 (E PRUP) S)
(POP P 2)
(CALL 2 (E XCONS) S)
TAG1 (SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP LISTSUBT SUBR)
(PUSH P 1)
(PUSH P 2)
(CALL 1 (E LENGTH) S)
(EXCH 1 0 P)
(CALL 1 (E LENGTH) S)
(MOVE 2 1)
(POP P 1)
(CALL 2 (E *DIF) S)
(MOVEI 3 (QUOTE NIL))
(MOVE 2 1)
(POP P 1)
(JCALL 3 (E LISTSUBTA) S)
NIL
(LAP LISTSUBTA SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(MOVEI 2 (QUOTE 0))
(MOVE 1 -1 P)
(CALL 2 (E EQUAL) S)
(JUMPE 1 TAG2)
(MOVE 1 0 P)
(JRST 0 TAG1)
TAG2 (HRRZ@ 1 -2 P)
(PUSH P 1)
(MOVE 1 -2 P)
(CALL 1 (E SUB1) S)
(MOVE 2 -1 P)
(PUSH P 1)
(HLRZ@ 1 -4 P)
(CALL 2 (E CONS) S)
(MOVE 3 1)
(POP P 2)
(POP P 1)
(CALL 3 (E LISTSUBTA) S)
TAG1 (SUB P (C 3 0 3 0))
(POPJ P)
NIL
(LAP CONTAINED SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPE 1 TAG1)
(HLRZ@ 1 1)
(CALL 2 (E MEMBER) S)
(JUMPE 1 TAG5)
(MOVE 2 0 P)
(HRRZ@ 1 -1 P)
(CALL 2 (E CONTAINED) S)
(JUMPN 1 TAG1)
TAG5 (TDZA 1 1)
TAG1 (MOVEI 1 (QUOTE T) S)
(SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP DELETE SUBR)
(PUSH P 1)
(PUSH P 2)
(MOVE 1 2)
(JUMPE 1 TAG1)
(HLRZ@ 2 1)
(MOVE 1 -1 P)
(CALL 2 (E EQUAL) S)
(JUMPE 1 TAG2)
(HRRZ@ 1 0 P)
(JRST 0 TAG1)
TAG2 (HLRZ@ 1 0 P)
(HRRZ@ 2 0 P)
(PUSH P 1)
(MOVE 1 -2 P)
(CALL 2 (E DELETE) S)
(POP P 2)
(CALL 2 (E XCONS) S)
TAG1 (SUB P (C 2 0 2 0))
(POPJ P)
NIL
(LAP PICKOUT SUBR)
(MOVEI 4 (QUOTE NIL))
(MOVEI 3 (QUOTE NIL))
(JCALL 4 (E PICKOUTA) S)
NIL
(LAP PICKOUTA SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(PUSH P 4)
(JUMPN 2 TAG2)
(MOVE 2 4)
(MOVE 1 3)
(CALL 2 (E CONS) S)
(JRST 0 TAG1)
TAG2 (HLRZ@ 1 2)
(CALLF@ 1 -3 P)
(JUMPE 1 TAG4)
(MOVE 2 -1 P)
(HLRZ@ 1 -2 P)
(CALL 2 (E CONS) S)
(MOVE 4 0 P)
(MOVE 3 1)
(HRRZ@ 2 -2 P)
(MOVE 1 -3 P)
(CALL 4 (E PICKOUTA) S)
(JRST 0 TAG1)
TAG4 (MOVE 2 0 P)
(HLRZ@ 1 -2 P)
(CALL 2 (E CONS) S)
(MOVE 4 1)
(MOVE 3 -1 P)
(HRRZ@ 2 -2 P)
(MOVE 1 -3 P)
(CALL 4 (E PICKOUTA) S)
TAG1 (SUB P (C 4 0 4 0))
(POPJ P)
NIL